home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / GEM / GRAFBASE.I < prev    next >
Encoding:
Modula Implementation  |  1993-12-10  |  12.5 KB  |  524 lines
  1. IMPLEMENTATION MODULE GrafBase;
  2. (*$L-, R-, Y+*)
  3.  
  4.  
  5. (*  Definition der grundlegenden Typen für die Grafikbibliotheken des
  6.  *  Megamax Modula-2 Entwicklungspackets. Außerdem Routinen zur Ver-
  7.  *  arbeitung dieser Strukturen.
  8.  *
  9.  *  Autor: Manuel Chakravarty           Erstellt: 28.10.87
  10.  *
  11.  *  Version   2.1     V#0021
  12.  *
  13.  *)
  14.  
  15. (*  28.10.87    | Definitionen
  16.  *  02.08.89    | 'FrameRects' korrigiert
  17.  *  13.08.89    | 'LongPnt', 'LongRect' def.; 'LPnt', 'LRect' def. + impl.
  18.  *  18.08.89    | 'Get...MemFormDef' benutzt jetzt Line-A (das Modul wird
  19.  *                nicht importiert um Zyklen zu vermeiden). Außerdem die
  20.  *                'L...'-Funktionen
  21.  *  01.02.90    | Angepaßt auf Compilerversion 4.0 (verdrehte SET's)
  22.  *  10.12.93    | LFramePoints korrigiert
  23.  *)
  24.  
  25.  
  26. FROM SYSTEM     IMPORT ASSEMBLER, ADDRESS;
  27.  
  28.  
  29. (*$L-*)
  30. PROCEDURE Pnt (x, y: INTEGER): Point; END Pnt;
  31. PROCEDURE LPnt (x, y: LONGINT): LongPnt; END LPnt;
  32.  
  33. PROCEDURE Rect (x, y, w, h: INTEGER): Rectangle; END Rect;
  34. PROCEDURE LRect (x, y, w, h: LONGINT): LongRect; END LRect;
  35. (*$L=*)
  36.  
  37. PROCEDURE ShortPoint (p: LongPnt): Point;
  38.  
  39.   (*$L-*)
  40.   BEGIN
  41.     ASSEMBLER
  42.         MOVE.L  -(A3), D1
  43.         MOVE.L  -4(A3), D0
  44.         MOVE.W  D0, -4(A3)
  45.         MOVE.W  D1, -2(A3)
  46.         ADDI.L  #8000, D0
  47.         SWAP    D0
  48.         TST.W   D0
  49.         BNE     err
  50.         ADDI.L  #8000, D1
  51.         SWAP    D1
  52.         TST.W   D1
  53.         BEQ     ende
  54.  
  55. err     TRAP    #6
  56.         DC.W    -7
  57.  
  58. ende
  59.     END;
  60.   END ShortPoint;
  61.   (*$L=*)
  62.   
  63. PROCEDURE LongPoint  (p: Point): LongPnt;
  64.  
  65.   (*$L-*)
  66.   BEGIN
  67.     ASSEMBLER
  68.         MOVE.L  -4(A3), D0
  69.         MOVE.W  D0, D1
  70.         EXT.L   D1
  71.         SWAP    D0
  72.         EXT.L   D0
  73.         MOVE.L  D0, -4(A3)
  74.         MOVE.L  D1, (A3)+
  75.     END;
  76.   END LongPoint;
  77.   (*$L=*)
  78.   
  79. PROCEDURE ShortFrame (frame: LongRect): Rectangle;
  80.  
  81.   (*$L-*)
  82.   BEGIN
  83.     ASSEMBLER
  84.         MOVE.L  -(A3), D1
  85.         MOVE.L  -(A3), D0
  86.         MOVE.W  D0, D2
  87.         SWAP    D2
  88.         MOVE.W  D1, D2
  89.         ADDI.L  #8000, D0
  90.         SWAP    D0
  91.         TST.W   D0
  92.         BNE     err
  93.         ADDI.L  #8000, D1
  94.         SWAP    D1
  95.         TST.W   D1
  96.         BEQ     cont
  97.  
  98. err     TRAP    #6
  99.         DC.W    -7
  100.  
  101. cont
  102.         MOVE.L  -4(A3), D1
  103.         MOVE.L  -8(A3), D0
  104.         MOVE.W  D0, -8(A3)
  105.         MOVE.W  D1, -6(A3)
  106.         MOVE.L  D2, -4(A3)
  107.         ADDI.L  #8000, D0
  108.         SWAP    D0
  109.         TST.W   D0
  110.         BNE     err2
  111.         ADDI.L  #8000, D1
  112.         SWAP    D1
  113.         TST.W   D1
  114.         BEQ     ende
  115.  
  116. err2    TRAP    #6
  117.         DC.W    -7
  118. ende
  119.     END;
  120.   END ShortFrame;
  121.   (*$L=*)
  122.   
  123. PROCEDURE LongFrame  (frame: Rectangle): LongRect;
  124.         
  125.   (*$L-*)
  126.   BEGIN
  127.     ASSEMBLER
  128.         MOVE.L  -8(A3), D0
  129.         MOVE.L  -4(A3), D2
  130.         MOVE.W  D0, D1
  131.         EXT.L   D1
  132.         SWAP    D0
  133.         EXT.L   D0
  134.         MOVE.L  D0, -8(A3)
  135.         MOVE.L  D1, -4(A3)
  136.         MOVE.W  D2, D1
  137.         EXT.L   D1
  138.         SWAP    D2
  139.         EXT.L   D2
  140.         MOVE.L  D2, (A3)+
  141.         MOVE.L  D1, (A3)+
  142.     END;
  143.   END LongFrame;
  144.   (*$L=*)
  145.   
  146.  
  147. PROCEDURE AbsZoomRect(frame:Rectangle;xDelta,yDelta:INTEGER):Rectangle;
  148.  
  149.   (*$L+*)
  150.   BEGIN
  151.     frame.x:=frame.x-xDelta;frame.y:=frame.y-yDelta;
  152.     frame.w:=frame.w+xDelta*2;frame.h:=frame.h+yDelta*2;
  153.     RETURN frame;
  154.   END AbsZoomRect;
  155.   (*$L=*)
  156.  
  157. PROCEDURE RelZoomRect(frame:Rectangle;xFactor,yFactor:LONGINT):Rectangle;
  158.  
  159.   VAR     newW, newH      : INTEGER;
  160.   
  161.   (*$L+*)
  162.   BEGIN
  163.     newW:=SHORT( LONG(frame.w)*xFactor DIV 1000L );
  164.     newH:=SHORT( LONG(frame.h)*yFactor DIV 1000L );
  165.     frame.x:=frame.x+frame.w DIV 2 -newW DIV 2;
  166.     frame.y:=frame.y+frame.h DIV 2 -newH DIV 2;
  167.     frame.w:=newW;
  168.     frame.h:=newH;
  169.     RETURN frame;
  170.   END RelZoomRect;
  171.   (*$L=*)
  172.  
  173. PROCEDURE TransRect (frame: Rectangle; p: Point): Rectangle;
  174.  
  175.   (*$L+*)
  176.   BEGIN
  177.     RETURN Rect(p.x,p.y,frame.w,frame.h);
  178.   END TransRect;
  179.   (*$L=*)
  180.   
  181. PROCEDURE LTransRect (frame: LongRect; p: LongPnt): LongRect;
  182.  
  183.   (*$L+*)
  184.   BEGIN
  185.     RETURN LRect (p.x, p.y, frame.w, frame.h);
  186.   END LTransRect;
  187.   (*$L=*)
  188.   
  189. PROCEDURE MinPoint (frame: Rectangle): Point;
  190.  
  191.   (*$L+*)
  192.   BEGIN
  193.     RETURN Pnt(frame.x,frame.y);
  194.   END MinPoint;
  195.   (*$L=*)
  196.                          
  197. PROCEDURE LMinPoint (frame: LongRect): LongPnt;
  198.  
  199.   (*$L+*)
  200.   BEGIN
  201.     RETURN LPnt(frame.x, frame.y);
  202.   END LMinPoint;
  203.   (*$L=*)
  204.                          
  205. PROCEDURE MaxPoint (frame: Rectangle): Point;
  206.  
  207.   (*$L+*)
  208.   BEGIN
  209.     RETURN Pnt(frame.x+frame.w-1,frame.y+frame.h-1);
  210.   END MaxPoint;
  211.   (*$L=*)
  212.                          
  213. PROCEDURE LMaxPoint (frame: LongRect): LongPnt;
  214.  
  215.   (*$L+*)
  216.   BEGIN
  217.     RETURN LPnt (frame.x + frame.w - 1L, frame.y + frame.h - 1L);
  218.   END LMaxPoint;
  219.   (*$L=*)
  220.                          
  221. PROCEDURE ClipRect (frame: Rectangle; clip: Rectangle): Rectangle;
  222.  
  223.   (*$L+*)
  224.   BEGIN
  225.     WITH frame DO
  226.       IF x<clip.x THEN w:=w-clip.x+x; x:=clip.x END;
  227.       IF y<clip.y THEN h:=h-clip.y+y; y:=clip.y END;
  228.       IF (w<=0) OR (h<=0) THEN w:=0;h:=0 END;
  229.       IF (x+w)>(clip.x+clip.w) THEN w:=clip.x+clip.w-x END;
  230.       IF (y+h)>(clip.y+clip.h) THEN h:=clip.y+clip.h-y END;
  231.       IF (w<=0) OR (h<=0) THEN w:=0;h:=0 END;
  232.     END;
  233.     RETURN frame;
  234.   END ClipRect;
  235.   (*$L=*)
  236.  
  237. PROCEDURE LClipRect (frame: LongRect; clip: LongRect): LongRect;
  238.  
  239.   (*$L+*)
  240.   BEGIN
  241.     WITH frame DO
  242.       IF x<clip.x THEN w:=w-clip.x+x; x:=clip.x END;
  243.       IF y<clip.y THEN h:=h-clip.y+y; y:=clip.y END;
  244.       IF (w<=0L) OR (h<=0L) THEN w:=0L;h:=0L END;
  245.       IF (x+w)>(clip.x+clip.w) THEN w:=clip.x+clip.w-x END;
  246.       IF (y+h)>(clip.y+clip.h) THEN h:=clip.y+clip.h-y END;
  247.       IF (w<=0L) OR (h<=0L) THEN w:=0L;h:=0L END;
  248.     END;
  249.     RETURN frame;
  250.   END LClipRect;
  251.   (*$L=*)
  252.  
  253. PROCEDURE FrameRects (r1, r2: Rectangle): Rectangle;
  254.  
  255.   VAR   r: Rectangle;
  256.   
  257.   (*$L+*)
  258.   BEGIN
  259.     WITH r DO
  260.       IF r1.x > r2.x THEN x := r2.x ELSE x := r1.x END;
  261.       IF r1.y > r2.y THEN y := r2.y ELSE y := r1.y END;
  262.       r1.w := r1.x + r1.w;
  263.       r2.w := r2.x + r2.w;
  264.       IF r1.w < r2.w THEN w := r2.w - x ELSE w := r1.w - x END;
  265.       r1.h := r1.y + r1.h;
  266.       r2.h := r2.y + r2.h;
  267.       IF r1.h < r2.h THEN h := r2.h - y ELSE h := r1.h - y END;
  268.     END;
  269.     
  270.     RETURN r
  271.   END FrameRects;
  272.   (*$L=*)
  273.  
  274. PROCEDURE LFrameRects (r1, r2: LongRect): LongRect;
  275.  
  276.   VAR   r: LongRect;
  277.   
  278.   (*$L+*)
  279.   BEGIN
  280.     WITH r DO
  281.       IF r1.x > r2.x THEN x := r2.x ELSE x := r1.x END;
  282.       IF r1.y > r2.y THEN y := r2.y ELSE y := r1.y END;
  283.       r1.w := r1.x + r1.w;
  284.       r2.w := r2.x + r2.w;
  285.       IF r1.w < r2.w THEN w := r2.w - x ELSE w := r1.w - x END;
  286.       r1.h := r1.y + r1.h;
  287.       r2.h := r2.y + r2.h;
  288.       IF r1.h < r2.h THEN h := r2.h - y ELSE h := r1.h - y END;
  289.     END;
  290.     
  291.     RETURN r
  292.   END LFrameRects;
  293.   (*$L=*)
  294.  
  295. PROCEDURE FramePoints (p1, p2: Point): Rectangle;
  296.  
  297.   (*$L-*)
  298.   BEGIN
  299.     ASSEMBLER
  300.         MOVE.W      -4(A3),D0    ; q.x -> d0
  301.         MOVE.W      D0,D1           ; q.x -> d1
  302.         SUB.W       -8(A3),D0    ; q.x-p.x -> d0
  303.         BCS         pxGreater       ; jump if p.x>q.x
  304.         ADDQ.W      #1,D0
  305.         MOVE.W      D0,-4(A3)    ; q.x-p.x+1 -> w
  306.         BRA         cont
  307. pxGreater
  308.         MOVE.W      D1,-8(A3)    ; q.x -> x
  309.         NOT.W       D0
  310.         ADDQ.W      #2,D0
  311.         MOVE.W      D0,-4(A3)    ; p.x-q.x+1 -> w
  312. cont
  313.         MOVE.W      -2(A3),D0    ; q.y -> d0
  314.         MOVE.W      D0,D1           ; q.y -> d1
  315.         SUB.W       -6(A3),D0    ; q.y-p.y -> d0
  316.         BCS         pyGreater       ; jump if p.y>q.y
  317.         ADDQ.W      #1,D0
  318.         MOVE.W      D0,-2(A3)    ; q.y-p.y+1 -> h
  319.         BRA         cont2
  320. pyGreater
  321.         MOVE.W      D1,-6(A3)    ; q.y -> y
  322.         NOT.W       D0
  323.         ADDQ.W      #2,D0
  324.         MOVE.W      D0,-2(A3)    ; p.y-q.y+1 -> h
  325. cont2
  326.     END;
  327.   END FramePoints;
  328.   (*$L=*)
  329.  
  330. PROCEDURE LFramePoints (p1, p2: LongPnt): LongRect;
  331.  
  332.   (*$L-*)
  333.   BEGIN
  334.     ASSEMBLER
  335.         MOVE.L      -8(A3),D0    ; q.x -> d0
  336.         MOVE.L      D0,D1           ; q.x -> d1
  337.         SUB.L       -16(A3),D0    ; q.x-p.x -> d0
  338.         BCS         pxGreater       ; jump if p.x>q.x
  339.         ADDQ.L      #1,D0
  340.         MOVE.L      D0,-8(A3)    ; q.x-p.x+1 -> w
  341.         BRA         cont
  342. pxGreater
  343.         MOVE.L      D1,-16(A3)    ; q.x -> x
  344.         NOT.L       D0
  345.         ADDQ.L      #2,D0
  346.         MOVE.L      D0,-8(A3)    ; p.x-q.x+1 -> w
  347. cont
  348.         MOVE.L      -4(A3),D0    ; q.y -> d0
  349.         MOVE.L      D0,D1           ; q.y -> d1
  350.         SUB.L       -12(A3),D0    ; q.y-p.y -> d0
  351.         BCS         pyGreater       ; jump if p.y>q.y
  352.         ADDQ.L      #1,D0
  353.         MOVE.L      D0,-4(A3)    ; q.y-p.y+1 -> h
  354.         BRA         cont2
  355. pyGreater
  356.         MOVE.L      D1,-12(A3)    ; q.y -> y
  357.         NOT.L       D0
  358.         ADDQ.L      #2,D0
  359.         MOVE.L      D0,-4(A3)    ; p.y-q.y+1 -> h
  360. cont2
  361.     END;
  362.   END LFramePoints;
  363.   (*$L=*)
  364.  
  365.  
  366. (*  calcFormSize -- Setzt eine MemFormDef auf ATARI-Screen Parameter *
  367.  *                  (ohne screen address). Zeiger auf MemForm in A0  *)
  368.  
  369. PROCEDURE calcFormSize;
  370.  
  371.   BEGIN
  372.     ASSEMBLER
  373.         MOVE.L  A0, -(A7)
  374.         DC.W    $A000           ; Line-A-Init
  375.         MOVE.L  (A7)+, A1
  376.     
  377.         MOVE.W  (A0), MemFormDef.planes(A1)
  378.         MOVE.W  2(A0), D0
  379.         LSR.W   #1, D0
  380.         MOVE.W  D0, MemFormDef.words(A1)
  381.         MOVE.W  -12(A0), MemFormDef.w(A1)
  382.         MOVE.W  -4(A0), MemFormDef.h(A1)
  383.         MOVE.W  #FALSE, MemFormDef.standardForm(A1)
  384.     END;
  385.   END calcFormSize;
  386.  
  387. PROCEDURE GetPhysMemForm(VAR memForm:MemFormDef);
  388.  
  389.   BEGIN
  390.     ASSEMBLER
  391.         MOVE.W      #2,-(A7)        ; XBIOS(2) -- Get physical screen addr
  392.         TRAP        #14
  393.         ADDQ.L      #2,A7
  394.         MOVE.L      -(A3),A0
  395.         MOVE.L      D0,MemFormDef.start(A0)
  396.         JMP         calcFormSize
  397.     END;
  398.   END GetPhysMemForm;
  399.  
  400. PROCEDURE GetLogMemForm(VAR memForm:MemFormDef);
  401.  
  402.   BEGIN
  403.     ASSEMBLER
  404.         MOVE.W      #3,-(A7)        ; XBIOS(3) -- Get logical screen addr
  405.         TRAP        #14
  406.         ADDQ.L      #2,A7
  407.         MOVE.L      -(A3),A0
  408.         MOVE.L      D0,MemFormDef.start(A0)
  409.         JMP         calcFormSize
  410.     END;
  411.   END GetLogMemForm;
  412.  
  413.  
  414. PROCEDURE GetBlitterMode(VAR avaible,active:BOOLEAN);
  415.  
  416. BEGIN
  417.   ASSEMBLER
  418.         MOVE.W  #-1,-(A7)
  419.         MOVE.W  #64,-(A7)
  420.         TRAP    #14
  421.         ADDQ.L  #4,A7
  422.         CLR.W   D1
  423.         
  424.         BTST    #0,D0
  425.         SEQ     D1
  426.         ADDQ.B  #1,D1
  427.         MOVE.L  -(A3),A0
  428.         MOVE.W  D1,(A0)
  429.         
  430.         BTST    #1,D0
  431.         SEQ     D1
  432.         ADDQ.B  #1,D1
  433.         MOVE.L  -(A3),A0
  434.         MOVE.W  D1,(A0)
  435.   END;
  436. END GetBlitterMode;
  437.  
  438. PROCEDURE SetBlitterMode(active:BOOLEAN);
  439.  
  440. BEGIN
  441.   ASSEMBLER
  442.         MOVE.W  -(A3),-(A7)
  443.         MOVE.W  #64,-(A7)
  444.         TRAP    #14
  445.         ADDQ.L  #4,A7
  446.   END;
  447. END SetBlitterMode;
  448.  
  449.  
  450. PROCEDURE GetScreen(VAR log,phys:ADDRESS;VAR rez:INTEGER);
  451.  
  452. BEGIN
  453.   ASSEMBLER
  454.         MOVE.W  #4,-(A7)        ; XBIOS(4) -- get screen resolution
  455.         TRAP    #14
  456.         ADDQ.L  #2,A7
  457.         MOVE.L  -(A3),A0
  458.         MOVE.W  D0,(A0)
  459.         
  460.         MOVE.W  #2,-(A7)        ; XBIOS(2) -- Get physical screen addr
  461.         TRAP    #14
  462.         ADDQ.L  #2,A7
  463.         MOVE.L  -(A3),A0
  464.         MOVE.L  D0,(A0)
  465.         
  466.         MOVE.W  #3,-(A7)        ; XBIOS(3) -- Get logical screen addr
  467.         TRAP    #14
  468.         ADDQ.L  #2,A7
  469.         MOVE.L  -(A3),A0
  470.         MOVE.L  D0,(A0)
  471.   END;
  472. END GetScreen;
  473.  
  474. PROCEDURE SetScreen(log,phys:ADDRESS;rez:INTEGER);
  475.     
  476. BEGIN
  477.   ASSEMBLER
  478.         MOVE.W  -(A3),-(A7)
  479.         MOVE.L  -(A3),-(A7)
  480.         MOVE.L  -(A3),-(A7)
  481.         MOVE.W  #5,-(A7)        ; XBIOS(5) -- Setscreen
  482.         TRAP    #14
  483.         ADDA.L  #12,A7
  484.   END;
  485. END SetScreen;
  486.  
  487. PROCEDURE SetPalette(newPalette:PtrPalette);
  488.  
  489. BEGIN
  490.   ASSEMBLER
  491.         MOVE.L  -(A3),-(A7)
  492.         MOVE.W  #6,-(A7)        ; XBIOS(6) -- Setpalette
  493.         TRAP    #14
  494.         ADDQ.L  #6,A7
  495.   END;
  496. END SetPalette;
  497.  
  498. PROCEDURE SetColor(colorNum,color:CARDINAL);
  499.  
  500. BEGIN
  501.   ASSEMBLER
  502.         MOVE.L  -(A3),-(A7)
  503.         MOVE.W  #7,-(A7)        ; XBIOS(7) -- Setcolor
  504.         TRAP    #14
  505.         ADDQ.L  #6,A7
  506.   END;
  507. END SetColor;
  508.  
  509. PROCEDURE ColorNumber(colorNum:CARDINAL):CARDINAL;
  510.  
  511. BEGIN
  512.   ASSEMBLER
  513.         MOVE.W  #-1,-(A7)       ; neg. color => inquire
  514.         MOVE.W  -(A3),-(A7)
  515.         MOVE.W  #7,-(A7)        ; XBIOS(7) -- Setcolor
  516.         TRAP    #14
  517.         ADDQ.L  #6,A7
  518.         MOVE.W  D0,(A3)+
  519.   END;
  520. END ColorNumber;
  521.  
  522.  
  523. END GrafBase.
  524.